home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 10 / FM Towns Free Software Collection 10.iso / ms_dos / lib / happysrc / piinst.c < prev    next >
Text File  |  1994-11-13  |  32KB  |  1,182 lines
  1. /************************************************
  2.  **
  3.  **    *** HAPPy P-code Interpreter ***
  4.  **
  5.  **            P-code命令解釈実行処理
  6.  **
  7.  **          Copyright (c) H.Asano. 1992-1994.
  8.  ************************************************/
  9.  
  10. #define EXTERN  extern
  11. #define trans(reg) \
  12.           ((unsigned short)(reg)-(unsigned short)(store))/sizeof(_store)
  13.  
  14. #define setlow   0
  15. #define sethigh 31
  16.  
  17. #include <process.h>
  18. #include <stdio.h>
  19. #include <string.h>
  20. #include <math.h>
  21. #include "hapai.h"
  22.  
  23. extern void prerr(short,char*); /* Run-timeエラーメッセージ出力処理   */
  24. extern void puteoln(void)     ; /* ファイルクローズ時のeoln付与処理   */
  25. extern void T_get(fileinfo*,_store*,char*);   /* 1文字読込            */
  26. extern void EOL(void) ;
  27. extern void EoF(void) ;
  28. extern void GET(void) ;
  29. extern void PGE(void) ;
  30. extern void PUT(void) ;
  31. extern void RLN(void) ;
  32. extern void RDC(void) ;
  33. extern void RDI(void) ;
  34. extern void RDR(void) ;
  35. extern void RST(void) ;
  36. extern void RWT(void) ;
  37. extern void TGT(void) ;
  38. extern void TPT(void) ;
  39. extern void TRS(void) ;
  40. extern void TRW(void) ;
  41. extern void WLN(void) ;
  42. extern void WRB(void) ;
  43. extern void WRC(void) ;
  44. extern void WRF(void) ;
  45. extern void WRI(void) ;
  46. extern void WRR(void) ;
  47. extern void WRS(void) ;
  48.  
  49. /**********************************************/
  50. /*** P-code 計算機のレジスタ、メモリその他  ***/
  51. /**********************************************/
  52.  
  53. extern _store store[] ; /* 記憶装置  */
  54.  
  55. extern _code  cd  ;     /* p-code    */
  56. extern _store *sp ;     /* sp points to top of the stack */
  57.  
  58. extern short   pc  ;    /* program counter */
  59. extern short   mp  ;    /* mp points to begginning of a data segment */
  60. extern short   ep  ;    /* ep points to the maxmum extent of the stack */
  61. extern short   np  ;    /* np points to top of the heap area      */
  62. extern boolean trace      ; /* 命令トレースフラグ                 */
  63. extern boolean readlnflag ; /* 起動時及びinputにreadlnをした時 真 */
  64.  
  65. /******** Run Time Error Mesage(埋め込み要のもの) **********/
  66. static const struct {
  67.                short  errno ;
  68.                char   *msg  ;
  69.              } errtbl[] = {
  70.  {  1,  "配列の添え字式の値(%ld)が範囲内(%ld～%ld)にない"},
  71.  {  7,  "実値引数の値(%ld)が範囲内(%ld～%ld)にない"},
  72.  {  8,  "実値引数の集合値が範囲内(%ld～%ld)にない"},
  73.  { 17,  "read: バッファ変数の値(%d)が範囲内(%ld～%ld)にない"},
  74.  { 18,  "write: 式の値(%ld)が範囲内(%ld～%ld)にない"},
  75.  { 26,  "pack: 順序型の引数の値(%ld)が範囲内(%ld～%ld)にない"},
  76.  { 29,  "unpack: 順序型の引数の値(%ld)が範囲内(%ld～%ld)にない"},
  77.  { 31,  "unpack: 転送後に詰めなし配列の添え字型を越える"},
  78.  { 38,  "succ: 引数の順序数(%ld)より1つ大きい値が存在しない"},
  79.  { 39,  "pred: 引数の順序数(%ld)より1つ小さい値が存在しない"},
  80.  { 49,  "代入文: 右辺値(%ld)が範囲内(%ld～%ld)にない"},
  81.  { 50,  "代入文: 集合値が範囲内(%ld～%ld)にない"},
  82.  { 51,  "case文: 選択式の値(%ld)に合致する選択定数がない"},
  83.  { 52,  "for文: 初期値(%ld)が範囲内(%ld～%ld)にない"},
  84.  { 53,  "for文: 終値(%ld)が範囲内(%ld～%ld)にない"},
  85.  { 71,  "read: 集合型のバッファ変数の値が範囲内(%ld～%ld)にない"},
  86.  { 72,  "write: 集合型の式の値が範囲内(%ld～%ld)にない"},
  87.  {111,  "集合構成子の順序式の値(%ld)がHAPPyの制限範囲内(%ld～%ld)にない"}
  88. } ;
  89.  
  90. /***************************************/
  91. /*   base() : 局所的番地を求める       */
  92. /***************************************/
  93. static short base(void)
  94. {
  95.   short  ad ;
  96.   short  ld ;
  97.  
  98.      if(cd.p==0) return(mp) ;           /* pが0ならmp値を返す         */
  99.      ad = mp ;
  100.      ld = cd.p  ;
  101.      while((ld--))                      /* 0より大きい間繰り返し      */
  102.       ad = store[ad+1].va ;             /* static link                */
  103.      return(ad) ;
  104. }
  105.  
  106. /***************************************/
  107. /*   StrComp() : 文字列の比較を行う    */
  108. /***************************************/
  109. static short StrComp(_store *str1,_store *str2,short length)
  110. {
  111.   register _store *s1,*s2 ;
  112.   short disp ;
  113.  
  114.      s1     = str1 ;
  115.      s2     = str2 ;
  116.      while(length--) {
  117.        disp = s1++->vc - s2++->vc ;
  118.        if(disp) return(disp) ;
  119.      }
  120.      return(0) ;                        /* s1とs2が同じ               */
  121. }
  122.  
  123. /************************ 各P-code の 処理 ****************************/
  124.  
  125. /******************/
  126. /*  ABI           */ /* absolute integers */
  127. /******************/
  128. static void ABI(void)
  129. {
  130.      (*sp).vi = labs((*sp).vi) ;
  131. }
  132.  
  133. /******************/
  134. /*  ABR           */ /* absolute reals */
  135. /******************/
  136. static void ABR(void)
  137. {
  138.      (*sp).vr = (float)fabs((double)(*sp).vr);
  139. }
  140.  
  141. /******************/
  142. /*  ADI           */ /* add integers */
  143. /******************/
  144. static void ADI(void)
  145. {
  146.      sp->vi += (sp--)->vi ;
  147. }
  148.  
  149. /******************/
  150. /*  ADR           */ /* add reals */
  151. /******************/
  152. static void ADR(void)
  153. {
  154.      sp-- ;
  155.      (*sp).vr += (*(sp+1)).vr ;
  156. }
  157.  
  158. /******************/
  159. /*  AND           */ /* logical and */
  160. /******************/
  161. static void AND(void)
  162. {
  163.      sp-- ;
  164.      (*sp).vb = (*sp).vb && (*(sp+1)).vb ;
  165. }
  166.  
  167. /**************************************/
  168. /* ATN() : arctan標準関数             */
  169. /**************************************/
  170. static void ATN(void)
  171. {
  172.      (*sp).vr = (float)atan((double)(*sp).vr);
  173. }
  174.  
  175. /******************/
  176. /*  BAS           */  /* load base mark */
  177. /******************/
  178. static void BAS(void)
  179. {
  180.      (*++sp).va = base() ;
  181. }
  182.  
  183. /*****************/
  184. /*  CHK          */
  185. /*****************/
  186. static void CHK(void)
  187. {
  188.   short i      ;
  189.   char buf[80] ;
  190.  
  191.      if(((*sp).vi < store[cd.q-1].vi) ||
  192.         ((*sp).vi > store[cd.q].vi)) {
  193.       i = -1 ;
  194.       while(errtbl[++i].errno != cd.p) ;
  195.       sprintf(buf,errtbl[i].msg,
  196.                   (*sp).vi, store[cd.q-1].vi,store[cd.q].vi) ;
  197.       prerr(cd.p,buf) ;               /* エラーメッセージ出力       */
  198.      }
  199. }
  200.  
  201. /******************/
  202. /*  CHKs          */  /* check set */
  203. /******************/
  204. static void CHKs(void)
  205. {
  206.   short i      ;
  207.   long  s = 0  ;                        /* 集合                       */
  208.   char buf[80] ;
  209.  
  210.       for(i=(short)store[cd.q-1].vi;i<=(short)store[cd.q].vi;i++)
  211.        addset(s,i);
  212.       s  = (~s & (*sp).vs) ;
  213.       if(s != 0) {
  214.        i = -1 ;
  215.        while(errtbl[++i].errno != cd.p) ;
  216.        sprintf(buf,errtbl[i].msg,
  217.                   store[cd.q-1].vi,store[cd.q].vi) ;
  218.        prerr(cd.p,buf) ;               /* エラーメッセージ出力       */
  219.       }
  220. }
  221.  
  222. /******************/
  223. /*  CHR           */  /* convert character */
  224. /******************/
  225. static void CHR(void)
  226. {
  227.     char buf[80] ;
  228.  
  229.      if(((*sp).vi < 0L) || (255L < (*sp).vi)) {
  230.       sprintf(buf,"chr: 引数の値(%ld)に対応する文字がない",(*sp).vi);
  231.       prerr(9,buf) ;
  232.      }
  233.         /* integer と char エリアは　0～255の範囲では同一なので変換不要 */
  234. }
  235.  
  236. /******************/
  237. /*  CKA           */  /* Check Address */
  238. /******************/
  239. static void CKA(void)
  240. {
  241.      if((*sp).va == NilValue)
  242.       prerr(3,"対象変数のポインタ変数の値がnilである") ;
  243.  
  244.      if(!((np <= (*sp).va) && ((*sp).va < Maxstore)))
  245.       prerr(4,"対象変数のポインタ変数の値が不定である") ;
  246. }
  247.  
  248. /**************************************/
  249. /* COS() : cos標準関数                */
  250. /**************************************/
  251. static void COS(void)
  252. {
  253.      (*sp).vr = (float)cos((double)(*sp).vr) ;
  254. }
  255.  
  256. /******************/
  257. /*  CUI           */ /* Call User procedure Indirect */
  258. /******************/
  259. static void CUI(void)
  260. {
  261.   short calladr ;
  262.  
  263.      calladr = (*sp--).va     ;         /* 実行開始アドレス取得       */
  264.      mp= trans(sp) - (cd.p+4) ;         /* 4はmstと関係               */
  265.      store[mp+4].va = pc      ;         /* 戻り番地                   */
  266.      pc = calladr             ;         /* jump                       */
  267. }
  268.  
  269. /******************/
  270. /*  CUP           */ /* Call User Procedure */
  271. /******************/
  272. static void CUP(void)
  273. {
  274.      mp =trans(sp) - (cd.p+4) ;         /* 4はmstと関係*/
  275.      store[mp+4].va = pc      ;         /* 戻り番地    */
  276.      pc = cd.q                ;         /* jump        */
  277. }
  278.  
  279. /******************/
  280. /*  DEC           */
  281. /******************/
  282. static void DEC(void)
  283. {
  284.      if(cd.p==1) (*sp).vi -= cd.q ;     /* 1(i)                       */
  285.      else        (*sp).vc -= cd.q ;     /* 0(a) 3(b) 6(c)             */
  286.                      /* ↑ boolean,char,addressエリアは同一           */
  287. }
  288.  
  289. /******************/
  290. /*  DIF           */
  291. /******************/
  292. static void DIF(void)
  293. {
  294.      sp--;
  295.      (*sp).vs  &= ((*sp).vs ^ (*(sp+1)).vs) ;
  296. }
  297.  
  298. /**************************************/
  299. /* DIS() : dispose標準手続き          */
  300. /**************************************/
  301. static void DIS(void)
  302. {
  303.   short ad ;
  304.  
  305.      ad = (*sp--).va ;                  /* 解放するアドレス           */
  306.      if(ad == NilValue)
  307.       prerr(23,"dispose: 引数の値がnilである") ;
  308.      if((np <= ad) && (ad < Maxstore)) {      /* 正常値               */
  309.       if(ad == np) np += cd.q ;               /* 一番後にnewした時だけ*/
  310.                                               /* 本当に解放する       */
  311.      }
  312.      else prerr(24,"dispose: 引数の値が不定である") ;
  313. }
  314.  
  315. /******************/
  316. /*  DVI           */
  317. /******************/
  318. static void DVI(void)
  319. {
  320.      if((*sp--).vi == 0) prerr(45,"div演算子: 0で割ろうとしている") ;
  321.      (*sp).vi /= (*(sp+1)).vi ;
  322. }
  323.  
  324. /******************/
  325. /*  DVR           */
  326. /******************/
  327. static void DVR(void)
  328. {
  329.      if((*sp--).vr == (float)0.0)
  330.       prerr(44,"/演算子: 0で割ろうとしている") ;
  331.      (*sp).vr /= (*(sp+1)).vr ;
  332. }
  333.  
  334. /******************/
  335. /*  EJP           */  /* Extra block Jump */
  336. /******************/
  337. static void EJP(void)
  338. {
  339.   short req ;
  340.  
  341.      req = base() ;
  342.      while(mp != req) {                 /* スタックの枠を解放         */
  343.       sp = store + mp - 1 ;
  344.       ep = store[mp+3].va ;             /* mp+3 ･･･ 旧ep              */
  345.       mp = store[mp+2].va ;             /* mp+2 ･･･ 動鎖              */
  346.      }
  347.      pc = cd.q;
  348. }
  349.  
  350. /******************/
  351. /*  ENT           */
  352. /******************/
  353. static void ENT(void)
  354. {
  355.      sp = store + mp + cd.q - 1   ;    /* スタックポインタ設定        */
  356.      if((ep = trans(sp)+cd.p) >= np)   /* スタックの枠限界設定
  357.                                             &  スタックチェック       */
  358.        prerr(122,"スタック用のメモリが不足している") ;
  359. }
  360.  
  361. /******************/
  362. /*  EQU           */
  363. /******************/
  364. static void EQU(void)
  365. {
  366.      sp-- ;
  367.  
  368.      switch(cd.p) {
  369.       case 1: /* (*sp).vb = (*sp).vi == (*(sp+1)).vi ; return; */
  370.       case 2: /* (*sp).vb = (*sp).vr == (*(sp+1)).vr ; return; */
  371.       case 4:    (*sp).vb = (*sp).vs == (*(sp+1)).vs ; return;
  372.  
  373.       case 6: /* (*sp).vb = (*sp).vc == (*(sp+1)).vc ; return; */
  374.       case 0: /* (*sp).vb = (*sp).va == (*(sp+1)).va ; return; */
  375.       case 3:    (*sp).vb = (*sp).vb == (*(sp+1)).vb ; return;
  376.  
  377.       case 5: (*sp).vb = (StrComp(store+(*sp).va,
  378.                                   store+(*(sp+1)).va,
  379.                                   cd.q) == 0);
  380.      }
  381. }
  382.  
  383. /**************************************/
  384. /* EXP() : exp標準関数                */
  385. /**************************************/
  386. static void EXP(void)
  387. {
  388.      (*sp).vr = (float)exp((double)(*sp).vr) ;
  389. }
  390.  
  391. /******************/
  392. /*  FJP           */
  393. /******************/
  394. static void FJP(void)
  395. {
  396.      if(! (*(sp--)).vb) pc = cd.q;
  397. }
  398.  
  399. /******************/
  400. /*  FLO           */
  401. /******************/
  402. static void FLO(void)
  403. {
  404.      (*(sp-1)).vr = (float)(*(sp-1)).vi ;
  405. }
  406.  
  407. /******************/
  408. /*  FLT           */
  409. /******************/
  410. static void FLT(void)
  411. {
  412.      (*sp).vr = (float)(*sp).vi ;
  413. }
  414.  
  415. /******************/
  416. /*  GEQ           */
  417. /******************/
  418. static void GEQ(void)
  419. {
  420.      sp-- ;
  421.      switch(cd.p) {
  422.       case 1:    (*sp).vb = (*sp).vi >= (*(sp+1)).vi ;  return;
  423.  
  424.       case 2:    (*sp).vb = (*sp).vr >= (*(sp+1)).vr ;  return;
  425.  
  426.       case 6: /* (*sp).vb = (*sp).vc >= (*(sp+1)).vc ;  return; */
  427.       case 3:    (*sp).vb = (*sp).vb >= (*(sp+1)).vb ;  return;
  428.  
  429.       case 4:    (*sp).vb = !
  430.                     ((*(sp+1)).vs & ((*(sp+1)).vs ^ (*sp).vs)) ; return;
  431.  
  432.       case 5:    (*sp).vb = (StrComp(store+(*sp).va,
  433.                                   store+(*(sp+1)).va,
  434.                                   cd.q) >= 0);
  435.      }
  436. }
  437.  
  438. /******************/
  439. /*  GRT           */
  440. /******************/
  441. static void GRT(void)
  442. {
  443.      sp-- ;
  444.      switch(cd.p) {
  445.       case 1:    (*sp).vb = (*sp).vi > (*(sp+1)).vi ;  return;
  446.  
  447.       case 6: /* (*sp).vb = (*sp).vc > (*(sp+1)).vc ;  return; */
  448.       case 3:    (*sp).vb = (*sp).vb > (*(sp+1)).vb ;  return;
  449.  
  450.       case 2: (*sp).vb = (*sp).vr > (*(sp+1)).vr ;  return;
  451.  
  452.       case 5: (*sp).vb = (StrComp(store+(*sp).va,
  453.                                   store+(*(sp+1)).va,
  454.                                   cd.q) > 0);
  455.      }
  456. }
  457.  
  458. /******************/
  459. /*  INC           */
  460. /******************/
  461. static void INC(void)
  462. {
  463.      if(cd.p==1) (*sp).vi += cd.q ;     /* 1(i)                       */
  464.      else        (*sp).vc += cd.q ;     /* 0(a) 3(b) 6(c)             */
  465.                      /* ↑ boolean,char,addressエリアは同一           */
  466. }
  467.  
  468. /******************/
  469. /*  IND           */    /* INDirect */
  470. /******************/
  471. static void IND(void)
  472. {
  473.      (*sp)=store[(*sp).va+cd.q] ;
  474. }
  475.  
  476. /******************/
  477. /*  INDa          */    /* INDirect address */
  478. /******************/
  479. static void INDa(void)
  480. {
  481.      (*sp).va=store[(*sp).va+cd.q].va ;
  482. }
  483.  
  484. #define INDb INDa
  485. #define INDs IND
  486. #define INDr IND
  487.  
  488. /******************/
  489. /*  INDc          */  /* INDirect character */
  490. /******************/
  491.      /* inputバッファの値が決まっていない時のために
  492.         特別な処理が必要なので、この処理を作りました */
  493. static void INDc(void)
  494. {
  495.   short adr ;
  496.  
  497.      adr = (*sp).va+cd.q ;
  498.      if((adr == fi[0].fileadr) && readlnflag) {
  499.       T_get(fi,store+adr,"get");
  500.       readlnflag = false ;
  501.      }
  502.  
  503.      (*sp).vc = store[adr].vc ;
  504. }
  505.  
  506. /******************/
  507. /*  INN           */
  508. /******************/
  509. static void INN(void)
  510. {
  511.   integer i;
  512.  
  513.      i=(*(--sp)).vi ;
  514.      (*sp).vb =
  515.        (i & 0xffffffe0)                 /* 0<=i<=31 かどうかの判定    */
  516.         ? (boolean)false
  517.         : (boolean)(((*(sp+1)).vs >> (char)i) & 0x1) ;
  518. }
  519.  
  520. /******************/
  521. /*  INT           */
  522. /******************/
  523. static void INT(void)
  524. {
  525.      sp--;
  526.      (*sp).vs &= (*(sp+1)).vs  ;
  527. }
  528.  
  529. /******************/
  530. /*  IOR           */ /* logical inclusive or */
  531. /******************/
  532. static void IOR(void)
  533. {
  534.      sp-- ;
  535.      (*sp).vb = (*sp).vb || (*(sp+1)).vb ;
  536. }
  537.  
  538. /******************/
  539. /*  IXA           */
  540. /******************/
  541. static void IXA(void)
  542. {
  543.   short disp ;
  544.  
  545.      disp = (short)((*sp--).vi - store[cd.q-1].vi);/* 配列の下限値を引く*/
  546.      (*sp).va += store[cd.q].va * disp ;
  547.                           /* ↑ vaは2バイトエリアとて使用             */
  548. }
  549.  
  550. /******************/
  551. /*  LAO           */  /* load base-level address */
  552. /******************/
  553. static void LAO(void)
  554. {
  555.      (*(++sp)).va = cd.q ;
  556. }
  557.  
  558. /******************/
  559. /*  LAP           */  /* Load Address Procedure */
  560. /******************/
  561. #define LAP LAO
  562.  
  563. /******************/
  564. /*  LCA           */
  565. /******************/
  566. #define LCA LAO
  567.  
  568. /******************/
  569. /*  LCI           */  /* load constant integer */
  570. /******************/
  571. #define LCI LDO
  572.  
  573. /******************/
  574. /*  LDA           */  /* load level p address */
  575. /******************/
  576. static void LDA(void)
  577. {
  578.      (*(++sp)).va = base()+cd.q ;
  579. }
  580.  
  581. /******************/
  582. /*  LDC           */  /* load constant */
  583. /******************/
  584. static void LDC(void)
  585. {
  586.      sp++ ;
  587.      switch(cd.p) {
  588.       case 1 :    (*sp).vi = cd.q;        return ;    /* integer */
  589.  
  590.       case 6 : /* (*sp).vc = cd.q;        return ; */ /* char    */
  591.       case 3 :    (*sp).vb = cd.q;        return ;    /* boolean */
  592.  
  593.       case 2 : /* (*sp).vr = store[cd.q].vr; return;*//* real    */
  594.       case 4 :    *sp = store[cd.q]; return;          /* set     */
  595.  
  596.       case 0 :    (*sp).va = NilValue ;               /* nil     */
  597.                               /* programmer が 生成できない値    */
  598.      }
  599. }
  600.  
  601. /******************/
  602. /*  LDO           */  /* load contents of base-level address */
  603. /******************/
  604. static void LDO(void)
  605. {
  606.      *(++sp)=store[cd.q] ;
  607. }
  608.  
  609. /******************/
  610. /*  LDOc          */  /* load char of base-level address */
  611. /******************/
  612.      /* inputバッファの値が決まっていない時のために
  613.         特別な処理が必要なので、この処理を作りました */
  614. static void LDOc(void)
  615. {
  616.      if((cd.q == fi[0].fileadr) && readlnflag) {
  617.       T_get(fi,store+cd.q,"get");
  618.       readlnflag = false ;
  619.      }
  620.  
  621.      (*(++sp)).vc = store[cd.q].vc ;
  622. }
  623.  
  624. /******************/
  625. /*  LDOa          */  /* load char of base-level address */
  626. /******************/
  627. static void LDOa(void)
  628. {
  629.      (*(++sp)).va = store[cd.q].va ;
  630. }
  631.  
  632. #define LDOb LDOa
  633. #define LDOr LDO
  634. #define LDOs LDO
  635.  
  636. /******************/
  637. /*  LEQ           */
  638. /******************/
  639. static void LEQ(void)
  640. {
  641.      sp-- ;
  642.      switch(cd.p) {
  643.       case 1:    (*sp).vb = (*sp).vi <= (*(sp+1)).vi ; return;
  644.  
  645.       case 2:    (*sp).vb = (*sp).vr <= (*(sp+1)).vr ; return;
  646.  
  647.       case 6: /* (*sp).vb = (*sp).vc <= (*(sp+1)).vc ; return; */
  648.       case 3:    (*sp).vb = (*sp).vb <= (*(sp+1)).vb ; return;
  649.  
  650.       case 4:    (*sp).vb = !
  651.                    ((*sp).vs & ((*sp).vs ^ (*(sp+1)).vs)) ; return;
  652.  
  653.       case 5:    (*sp).vb = (StrComp(store+(*sp).va,
  654.                                      store+(*(sp+1)).va,
  655.                                      cd.q) <= 0);
  656.      }
  657. }
  658.  
  659. /******************/
  660. /*  LES           */
  661. /******************/
  662. static void LES(void)
  663. {
  664.      sp-- ;
  665.      switch(cd.p) {
  666.       case 1:    (*sp).vb = (*sp).vi < (*(sp+1)).vi ; return;
  667.  
  668.       case 2:    (*sp).vb = (*sp).vr < (*(sp+1)).vr ; return;
  669.  
  670.       case 6: /* (*sp).vb = (*sp).vc < (*(sp+1)).vc ; return; */
  671.       case 3:    (*sp).vb = (*sp).vb < (*(sp+1)).vb ; return;
  672.  
  673.       case 5:    (*sp).vb = (StrComp(store+(*sp).va,
  674.                                      store+(*(sp+1)).va,
  675.                                      cd.q) < 0);
  676.      }
  677. }
  678.  
  679. /******************/
  680. /*  LOD           */  /* load contents of address at level p */
  681. /******************/
  682. static void LOD(void)
  683. {
  684.      *(++sp) = store[base()+cd.q] ;
  685. }
  686.  
  687. /******************/
  688. /*  LODa          */  /* load contents of address at level p */
  689. /******************/
  690. static void LODa(void)
  691. {
  692.      (*(++sp)).va = store[base()+cd.q].va ;
  693. }
  694.  
  695. #define LODc LODa
  696. #define LODb LODa
  697. #define LODs LOD
  698. #define LODr LOD
  699.  
  700. /**************************************/
  701. /* LOG() : ln標準関数                 */
  702. /**************************************/
  703. static void LOG(void)
  704. {
  705.      if((*sp).vr <= (float)0.0)
  706.       prerr(33,"ln: 引数の値が0以下である") ;
  707.      (*sp).vr = (float)log((double)(*sp).vr);
  708. }
  709.  
  710. /******************/
  711. /*  MMS           */  /* Make Multiple Set */
  712. /******************/
  713. /* この命令だけが -dオプション指定時 自前でチェックを行っている。
  714.    統一がとれていないけど 暫定的処置である */
  715.  
  716. static void MMS(void)
  717. {
  718.   long    s = 0;
  719.   short   i ;
  720.   long    low,high ;                    /* 下限 上限                  */
  721.   char    buf[80]  ;
  722.  
  723.      sp--    ;
  724.      if(cd.p<=1) {                      /* p in [0,1]                 */
  725.       low  = sp->vi ;
  726.       high = (sp+1)->vi ;
  727.      }
  728.      else {                             /* p in [2,3]                 */
  729.       low  = (sp+1)->vi ;
  730.       high = sp->vi ;
  731.      }
  732.      if(cd.p & 0x1)                     /* p in [1,3] (-dｵﾌﾟｼｮﾝ)      */
  733.       if((low <= high) &&               /* 下限の方が大きい･･･要素なし*/
  734.          (((long)setlow > low) || (high > (long)sethigh))) {
  735.        sprintf(buf,
  736.         "集合: 式..式の値ががHAPPyの制限範囲内(%d～%d)にない",
  737.         setlow,sethigh) ;
  738.        prerr(112,buf) ;                /* エラーメッセージ出力       */
  739.       }
  740.      for(i=(short)low;i<=(short)high;i++) addset(s,(short)i);
  741.      (*sp).vs = s;
  742. }
  743.  
  744. /******************/
  745. /*  MOD           */
  746. /******************/
  747. static void MOD(void)
  748. {
  749.      if((*sp--).vi <= 0)
  750.       prerr(46,"mod演算子: 右辺値が0または負である") ;
  751.      (*sp).vi %= (*(sp+1)).vi ;
  752. }
  753.  
  754. /******************/
  755. /*  MOV           */
  756. /******************/
  757. static void MOV(void)
  758. {
  759.      if(cd.p==1)                        /* 通常                       */
  760.       memcpy(store+(sp-1)->va,
  761.              store+sp->va,  cd.q*sizeof(_store)) ;
  762.      else /* cd.p==2 */                 /* pack,unpack,writeの時使う  */
  763.       memcpy(store+sp->va,
  764.              store+(sp-1)->va,  cd.q*sizeof(_store)) ;
  765.  
  766.      sp-=2 ;
  767.  
  768. }
  769.  
  770. /******************/
  771. /*  MPI           */
  772. /******************/
  773. static void MPI(void)
  774. {
  775.      sp--;
  776.      (*sp).vi *= (*(sp+1)).vi ;
  777. }
  778.  
  779. /******************/
  780. /*  MPR           */
  781. /******************/
  782. static void MPR(void)
  783. {
  784.      sp--;
  785.      (*sp).vr *= (*(sp+1)).vr ;
  786. }
  787.  
  788. /******************/
  789. /*  MSI           */ /* Mark Stack Indirect */
  790. /******************/
  791. static void MSI(void)
  792. {
  793.      (*(sp+2)).va = (*(sp--)).va ;    /* 静鎖    */
  794.      (*(sp+3)).va = mp  ;             /* 動鎖    */
  795.      (*(sp+4)).va = ep  ;             /* 旧ep    */
  796.      sp += 5            ;
  797. }
  798.  
  799. /******************/
  800. /*  MST           */ /* Mark STack */
  801. /******************/
  802. static void MST(void)
  803. {
  804.      (*(sp+2)).va = base()  ;           /* 静鎖 */
  805.      (*(sp+3)).va = mp      ;           /* 動鎖 */
  806.      (*(sp+4)).va = ep      ;           /* 旧ep */
  807.      sp += 5                ;
  808. }
  809.  
  810. /******************/
  811. /*  NEQ           */
  812. /******************/
  813. static void NEQ(void)
  814. {
  815.      sp-- ;
  816.      switch(cd.p) {
  817.       case 1: /* (*sp).vb = (*sp).vi != (*(sp+1)).vi ; return; */
  818.       case 2: /* (*sp).vb = (*sp).vr != (*(sp+1)).vr ; return; */
  819.       case 4:    (*sp).vb = (*sp).vs != (*(sp+1)).vs ; return;
  820.  
  821.       case 0: /* (*sp).vb = (*sp).va != (*(sp+1)).va ; return; */
  822.       case 6: /* (*sp).vb = (*sp).vc != (*(sp+1)).vc ; return; */
  823.       case 3:    (*sp).vb = (*sp).vb != (*(sp+1)).vb ; return;
  824.  
  825.       case 5:    (*sp).vb = (StrComp(store+(*sp).va,
  826.                                      store+(*(sp+1)).va,
  827.                                      cd.q) != 0);
  828.      }
  829. }
  830.  
  831. /**************************************/
  832. /* NEW() : new標準手続き              */
  833. /**************************************/
  834. static void NEW(void)
  835. {
  836.   short ad ;
  837.  
  838.      np -= cd.q ;
  839.      if(np <= ep)
  840.        prerr(121,"new: メモリ不足で割り付けができない") ;
  841.      ad = (*sp--).va ;
  842.      store[ad].va = np ;
  843. }
  844.  
  845. /******************/
  846. /*  NGI           */
  847. /******************/
  848. static void NGI(void)
  849. {
  850.      (*sp).vi = - (*sp).vi ;
  851. }
  852.  
  853. /******************/
  854. /*  NGR           */
  855. /******************/
  856. static void NGR(void)
  857. {
  858.      (*sp).vr = - (*sp).vr ;
  859. }
  860.  
  861. /******************/
  862. /*  NOT           */
  863. /******************/
  864. static void NOT(void)
  865. {
  866.      (*sp).vb = ! (*sp).vb ;
  867. }
  868.  
  869. /******************/
  870. /*  NXT           */  /* next */  /* for ～ to */
  871. /******************/
  872. static void NXT(void)
  873. {
  874.      if(cd.p==1) store[mp+cd.q].vi++ ;
  875.      else        store[mp+cd.q].vc++ ;  /* 3(b) 6(c)                  */
  876.                               /* ↑ char と boolean は 同じエリア     */
  877. }
  878.  
  879. /******************/
  880. /*  NXD           */  /* next downto */  /* for ～ downto */
  881. /******************/
  882. static void NXD(void)
  883. {
  884.      if(cd.p==1) store[mp+cd.q].vi-- ;
  885.      else        store[mp+cd.q].vc-- ;  /* 3(b) 6(c)                  */
  886.                               /* ↑ char と boolean は 同じエリア     */
  887. }
  888.  
  889. /******************/
  890. /*  ODD           */
  891. /******************/
  892. static void ODD(void)
  893. {
  894.      (*sp).vb = (boolean)((*sp).vi & 0x00000001) ;
  895. }
  896.  
  897. /******************/
  898. /*  ORD           */  /* ORDinary */
  899. /******************/
  900. static void ORD(void)
  901. {
  902.                                /* vc も vb も同じエリアなのでif文不要 */
  903.    /*if(cd.p == 3)*/                   /* ordb                        */
  904.       (*sp).vi = (integer)(*sp).vb ;
  905.    /*else*/                            /* ordc                        */
  906.     /*(*sp).vi = (integer)(*sp).vc ;*/
  907. }
  908.  
  909. /******************/
  910. /*  RET           */
  911. /******************/
  912. static void RET(void)
  913. {
  914.      if(cd.p==0) sp = store + mp -1 ;   /* retp:p=0  p<>0は以下の命令 */
  915.      else        sp = store + mp    ;   /* reti,retr,retc,retb,rets   */
  916.      pc  = store[mp+4].va ;             /* pc 復帰                    */
  917.      ep  = store[mp+3].va ;             /* ep 復帰                    */
  918.      mp  = store[mp+2].va ;             /* mp 復帰                    */
  919. }
  920.  
  921. /******************/
  922. /*  ROU           */  /* round */
  923. /******************/
  924. static void ROU(void)
  925. {
  926.      (*sp).vi = (integer)floor((double)((*sp).vr + 0.5)) ;
  927. }
  928.  
  929. /******************/
  930. /*  SBI           */ /* subtruct integers */
  931. /******************/
  932. static void SBI(void)
  933. {
  934.      sp->vi -= (sp--)->vi ;
  935. }
  936.  
  937. /******************/
  938. /*  SBR           */ /* subtruct reals */
  939. /******************/
  940. static void SBR(void)
  941. {
  942.      sp-- ;
  943.      (*sp).vr -= (*(sp+1)).vr ;
  944. }
  945.  
  946. /******************/
  947. /*  SGS           */
  948. /******************/
  949. static void SGS(void)
  950. {
  951.   long s = 0 ;
  952.  
  953.      addset(s,(short)(*sp).vi) ;
  954.      (*sp).vs = s       ;
  955. }
  956.  
  957. /***************************************/
  958. /* SIN() : sin標準関数                 */
  959. /***************************************/
  960. static void SIN(void)
  961. {
  962.      (*sp).vr = (float)sin((double)(*sp).vr) ;
  963. }
  964.  
  965. /******************/
  966. /*  SQI           */
  967. /******************/
  968. static void SQI(void)
  969. {
  970.      (*sp).vi *= (*sp).vi ;
  971. }
  972.  
  973. /******************/
  974. /*  SQR           */
  975. /******************/
  976. static void SQR(void)
  977. {
  978.      (*sp).vr *= (*sp).vr ;
  979. }
  980.  
  981. /***************************************/
  982. /* SQT() : sqrt標準関数                */
  983. /***************************************/
  984. static void SQT(void)
  985. {
  986.      if((*sp).vr < (float)0.0)      /* 負の平方根                 */
  987.       prerr(34,"sqrt:引数の値が負である") ;
  988.      (*sp).vr = (float)sqrt((double)(*sp).vr);
  989. }
  990.  
  991. /******************/
  992. /*  SRO           */  /* store at base-level address */
  993. /******************/
  994. static void SRO(void)
  995. {
  996.      store[cd.q] = *(sp--) ;
  997. }
  998.  
  999. /******************/
  1000. /*  SROa          */  /* store at base-level address */
  1001. /******************/
  1002. static void SROa(void)
  1003. {
  1004.      store[cd.q].va = (*(sp--)).va ;
  1005. }
  1006.  
  1007. #define SROc SROa
  1008. #define SROb SROa
  1009. #define SROr SRO
  1010. #define SROs SRO
  1011.  
  1012. /******************/
  1013. /*  STO           */
  1014. /******************/
  1015. static void STO(void)
  1016. {
  1017.      store[(*(sp-1)).va] = *sp ;
  1018.      sp-=2 ;
  1019. }
  1020.  
  1021. /******************/
  1022. /*  STOa          */
  1023. /******************/
  1024. static void STOa(void)
  1025. {
  1026.      store[(*(sp-1)).va].va = (*sp).va ;
  1027.      sp-=2 ;
  1028. }
  1029.  
  1030. #define STOc STOa
  1031. #define STOb STOa
  1032. #define STOr STO
  1033. #define STOs STO
  1034.  
  1035. /******************/
  1036. /*  STP           */  /* stop */
  1037. /******************/
  1038. static void STP(void)
  1039. {
  1040.      puteoln() ;                        /* ファイルクローズ & eoln付与*/
  1041.      exit(0)   ;
  1042. }
  1043.  
  1044. /******************/
  1045. /*  STR           */  /* store contents at address at level p */
  1046. /******************/
  1047. static void STR(void)
  1048. {
  1049.      store[base()+cd.q] = *sp-- ;
  1050. }
  1051.  
  1052. /******************/
  1053. /*  STRa          */  /* store contents at address at level p */
  1054. /******************/
  1055. static void STRa(void)
  1056. {
  1057.      store[base()+cd.q].va = (*(sp--)).va ;
  1058. }
  1059.  
  1060. #define STRc STRa
  1061. #define STRb STRa
  1062. #define STRr STR
  1063. #define STRs STR
  1064.  
  1065.  
  1066. /******************/
  1067. /*  TRA           */  /* trace of execuction */
  1068. /******************/
  1069. static void TRA(void)
  1070. {
  1071.      trace = (cd.p==1) ;                /* tra 1 の時 トレースON      */
  1072. }
  1073.  
  1074. /******************/
  1075. /*  TRC           */  /* truncate */
  1076. /******************/
  1077. static void TRC(void)
  1078. {
  1079.      (*sp).vi = (integer)(*sp).vr ;
  1080. }
  1081.  
  1082. /******************/
  1083. /*  UDF           */  /* UnDeFined instruction */
  1084. /******************/
  1085. static void UDF(void)
  1086. {
  1087.      prerr(142,"未定義命令を実行しようとした") ;
  1088. }
  1089.  
  1090. /******************/
  1091. /*  UJC           */
  1092. /******************/
  1093. static void UJC(void)
  1094. {
  1095.      prerr(51,"case文: 選択式の値に合致する選択定数がない") ;
  1096. }
  1097.  
  1098. /******************/
  1099. /*  UJP           */
  1100. /******************/
  1101. static void UJP(void)
  1102. {
  1103.      pc = cd.q;
  1104. }
  1105.  
  1106. /******************/
  1107. /*  UNI           */
  1108. /******************/
  1109. static void UNI(void)
  1110. {
  1111.      sp--   ;
  1112.      (*sp).vs |= (*(sp+1)).vs  ;
  1113. }
  1114.  
  1115. /******************/
  1116. /*  XJP           */
  1117. /******************/
  1118. static void XJP(void)
  1119. {
  1120.      pc += (short)(*sp--).vi ;
  1121. }
  1122.  
  1123. /**********************************************************************/
  1124. /*                      P-code   別 処理エントリ表                    */
  1125. /**********************************************************************/
  1126.  
  1127. static struct entry {
  1128.        void (*func)(void) ;
  1129. } pcd[] = {
  1130.            /*         xx0  xx1  xx2  xx3  xx4  xx5  xx6  xx7  xx8  xx9   */
  1131.            /*00x*/    LOD, LDO, STR, SRO, STO, CHK, IND, LDC, LDA, DEC,
  1132.            /*01x*/    INC, MST, CUP, ENT, RET, UDF, IXA, EQU, NEQ, GEQ,
  1133.            /*02x*/    GRT, LEQ, LES, UJP, FJP, XJP, EJP, LAP, ADI, ADR,
  1134.            /*03x*/    SBI, SBR, SGS, FLT, FLO, TRC, NGI, NGR, SQI, SQR,
  1135.            /*04x*/    ABI, ABR, NOT, AND, IOR, DIF, INT, UNI, INN, MOD,
  1136.            /*05x*/    ODD, MPI, MPR, DVI, DVR, MOV, LCA, LAO, STP, ORD,
  1137.            /*06x*/    CHR, UJC, MMS, MSI, CUI, BAS, LCI, CKA, TRA, ROU,
  1138.            /*07x*/    NXT, NXD, UDF, UDF, UDF, NEW, DIS, PGE, EoF, EOL,
  1139.            /*08x*/    RST, RWT, GET, PUT, WRS, WRB, WRI, WRR, WRC, WRF,
  1140.            /*09x*/    WLN, RDI, RDR, RDC, RLN, TRS, TRW, TGT, TPT, ATN,
  1141.            /*10x*/    SIN, COS, EXP, LOG, SQT, LDOa,LDOr,LDOs,LDOb,LDOc,
  1142.            /*11x*/    UDF, UDF, CHKs,CHK, CHK, LODa,LODr,LODs,LODb,LODc,
  1143.            /*12x*/    SROa,SROr,SROs,SROb,SROc,STRa,STRr,STRs,STRb,STRc,
  1144.            /*13x*/    STOa,STOr,STOs,STOb,STOc,INDa,INDr,INDs,INDb,INDc,
  1145.            /*14x*/    UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF,
  1146.            /*15x*/    UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF,
  1147.            /*16x*/    UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF,
  1148.            /*17x*/    UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF,
  1149.            /*18x*/    UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF,
  1150.            /*19x*/    UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF,
  1151.            /*20x*/    UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF,
  1152.            /*21x*/    UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF,
  1153.            /*22x*/    UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF,
  1154.            /*23x*/    UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF,
  1155.            /*24x*/    UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF,
  1156.            /*25x*/    UDF, UDF, UDF, UDF, UDF, UDF
  1157.          };
  1158.  
  1159. /***********************/
  1160. /*     トレース処理    */
  1161. /***********************/
  1162. static void tracing(void)
  1163. {
  1164.      printf("%4d[%3d %1d %6d] mp=%4d ep=%4d np=%4d stack[%4d]=%08lxH\n",
  1165.        pc-1,cd.op,cd.p,cd.q, mp,ep,np,trans(sp),(*sp).vi);
  1166. }
  1167.  
  1168. /********************************/
  1169. /*      P-code の 解釈実行処理  */
  1170. /********************************/
  1171. void interpret(void)
  1172. {
  1173. loop:
  1174.      cd = store[pc++].vo ;
  1175.  
  1176.      if(trace) tracing() ;              /* トレースオプション有効     */
  1177.  
  1178.      pcd[cd.op].func()   ;              /* opに対応した命令を実行     */
  1179.  
  1180.      goto loop;
  1181. }
  1182.